home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 06 - 1990 / 06.02 Feb 90 / BTMPeditor / PascalDemoBTMP / PascalDemoBTMP.p next >
Encoding:
Text File  |  1989-07-10  |  2.4 KB  |  102 lines  |  [TEXT/PJMM]
  1. (* File PascalDemoBTMP.p *)
  2. (* A short example of how to use the 'BTMP' data structure *)
  3. (* in a Pascal program. *)
  4.  
  5. program PascalDemoBTMP;
  6.  
  7.     type
  8.         BitMapPtr = ^BitMap;
  9.  
  10.         BTMP = record
  11.                 baseAddr: Ptr;
  12.                 rowBytes: integer;
  13.                 bounds: Rect;
  14.                 bitImage: array[0..0] of integer;
  15.             end;
  16.         BTMPPtr = ^BTMP;
  17.         BTMPHndl = ^BTMPPtr;
  18.  
  19.     const
  20.         DFLT_BTMP_HEIGHT = 10;
  21.         DFLT_BTMP_WIDTH = 20;
  22.         DFLT_ROWBYTES = ((((DFLT_BTMP_WIDTH - 1) div 16) + 1) * 2);
  23.         DFLT_BTMP_SIZE = (DFLT_BTMP_HEIGHT * DFLT_ROWBYTES);
  24.         kLockStateFlag = $80;
  25.  
  26.     var
  27.         theRect: Rect;
  28.         theBitMapHndl: BTMPHndl;
  29.  
  30. (************************************************************)
  31.  
  32.     function GetABTMP: BTMPHndl;
  33. (* create a sample BTMP resource and fill it with a striped pattern *)
  34.         var
  35.             h: BTMPHndl;
  36.             p: BTMPPtr;
  37.             bitsPtr: ^integer;
  38.             i, nWords: integer;
  39.     begin
  40.         h := BTMPHndl(NewHandle(sizeof(BTMP) - sizeof(integer) + DFLT_BTMP_SIZE));
  41.         p := h^;
  42.         p^.baseAddr := nil;
  43.         p^.rowbytes := DFLT_ROWBYTES;
  44.         SetRect(p^.bounds, 0, 0, DFLT_BTMP_WIDTH, DFLT_BTMP_HEIGHT);
  45.         bitsPtr := @p^.bitImage;
  46.         nWords := DFLT_BTMP_SIZE div 2;
  47.         for i := 1 to nWords do
  48.             begin
  49.                 bitsPtr^ := 2816; (* striped pattern *)
  50.                 bitsPtr := Pointer(longint(bitsPtr) + sizeof(integer));
  51.             end;
  52.         GetABTMP := h;
  53.     end;
  54.  
  55. (************************************************************)
  56.  
  57.     procedure PlotPBitMap (r: Rect; p: BTMPPtr; mode: integer);
  58.         var
  59.             port: GrafPtr;
  60.     begin
  61.         GetPort(port);
  62.         CopyBits(BitMapPtr(p)^, port^.portBits, p^.bounds, r, mode, nil);
  63.     end;
  64.  
  65. (************************************************************)
  66.  
  67.     function LockBitMap (h: BTMPHndl): SignedByte;
  68.         var
  69.             origState: SignedByte;
  70.             theBitMapPtr: BTMPPtr;
  71.     begin
  72.         origState := HGetState(Handle(h));
  73.         if (not Boolean(BitAnd(LONGINT(origState), kLockStateFlag))) then
  74.             begin
  75.                 MoveHHi(Handle(h));
  76.                 HLock(Handle(h));
  77.             end;
  78.         theBitMapPtr := h^;
  79.         theBitMapPtr^.baseAddr := @theBitMapPtr^.bitImage;
  80.         LockBitMap := origState;
  81.     end;
  82.  
  83. (************************************************************)
  84.  
  85.     procedure PlotBitMap (r: Rect; h: BTMPHndl; mode: integer);
  86. (* analogous to PlotIcon *)
  87.         var
  88.             origState: SignedByte;
  89.     begin
  90.         origState := LockBitMap(h);
  91.         PlotPBitMap(r, h^, mode);
  92.         h^^.baseAddr := nil;
  93.         HSetState(Handle(h), origState);
  94.     end;
  95.  
  96. (************************************************************)
  97.  
  98. begin
  99.     SetRect(theRect, 0, 0, DFLT_BTMP_WIDTH, DFLT_BTMP_HEIGHT);
  100.     theBitMapHndl := GetABTMP;
  101.     PlotBitMap(theRect, theBitMapHndl, srcCopy);
  102. end.